#!/usr/bin/perl

# Copyright © 2006-2014 Jakub Wilk <jwilk@jwilk.net>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the “Software”), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

use strict;
use warnings FATAL => qw(numeric);
no encoding;

use Date::Format qw(time2str);
use Date::Parse qw(str2time);
use Encode ();
use Encode::Locale ();
use English qw(-no_match_vars);
use File::Basename qw(dirname);
use Getopt::Long qw(:config gnu_compat permute no_getopt_compat no_ignore_case);
use HTML::Form ();
use HTML::HeadParser ();
use HTML::TreeBuilder ();
use HTTP::Cookies ();
use HTTP::Request::Common qw(GET POST);
use IO::Socket::SSL ();
use IPC::Run;
use JSON qw(encode_json);
use LWP::UserAgent;
use Net::HTTPS ();  # must be loaded after IO::Socket::SSL
use Net::SSLeay ();
use Text::ParseWords ();

# ==========================
# logging and error handling
# ==========================

my $opt_verbose = 0;
my $opt_debug_dir = undef;

sub write_log
{
    my ($message) = @_;
    defined($opt_debug_dir) or return;
    my $path = "$opt_debug_dir/log";
    open(my $log, '>>', $path)
        or os_error("$path: $ERRNO");
    print {$log} "$message\n";
    close($log)
        or os_error("$path: $ERRNO");
    return;
}

sub debug
{
    my ($message) = @_;
    $message = "* $message";
    write_log($message);
    if ($opt_verbose) {
        print {*STDERR} "$message\n";
    }
    return;
}

sub user_error
{
    my ($message) = @_;
    if (defined($message)) {
        write_log($message);
        print {*STDERR} "mbank-cli: $message\n";
    }
    exit(1);
}

sub config_error
{
    my ($config, $message) = @_;
    my $config_path;
    if (ref $config) {
        $config_path = $config->{__path__};
    } else {
        $config_path = $config;
    }
    $message = "$config_path: $message";
    return user_error($message);
}

sub http_error
{
    my ($request, $response) = @_;
    my $message = sprintf(
        'HTTP error %d while processing request <%s %s>',
        $response->code,
        $request->method,
        $request->uri
    );
    if ($EVAL_ERROR) {
        my $extra = $EVAL_ERROR;
        $extra =~ s/\n+$//;
        $extra =~ s/\n+/\n/g;
        if ($extra !~ /[(]/ and $IO::Socket::SSL::SSL_ERROR) {
            # https://bugs.debian.org/746686
            $extra .= "\n$IO::Socket::SSL::SSL_ERROR";
        }
        $extra =~ s/\n+$//;
        $extra =~ s/^/| /gm;
        $message .= "\n$extra\n";
    }
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(2);
}

sub http_decoding_error
{
    my ($request) = @_;
    my $message = sprintf(
        'HTTP decoding error while processing request <%s %s>',
        $request->method,
        $request->uri,
    );
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(2);
}

sub scraping_error
{
    my ($message) = @_;
    my $file = __FILE__;
    $message =~ s/ at \Q$file\E line \d+[.]\n+//;
    $message = "Scraping error: $message";
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(3);
}

sub os_error
{
    my ($message) = @_;
    if ((caller(1))[3] eq 'main::write_log') {
        # avoid infinite recursion
    } else {
        write_log($message);
    }
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(4);
}

sub internal_error
{
    my ($message, $level) = @_;
    $message = "Internal error: $message";
    write_log($message);
    local $Carp::CarpLevel = $level + 1;
    Carp::cluck($message);
    exit(255);
}

sub check_for_unexpected_options
{
    my %options = @_;
    return if not %options;
    my $message;
    {
        local $LIST_SEPARATOR = ', ';
        my @option_keys = sort(keys(%options));
        $message = "unexpected options: @option_keys";
    }
    return internal_error($message, 1);
}

# ====================
# internationalization
# ====================

my %_encoding_fallback = (
    0x104 => 'A', 0x105 => 'a', # letter A with ogonek
    0x0c1 => 'A', 0x0e1 => 'a', # letter A with acute
    0x0c4 => 'A', 0x0e4 => 'a', # letter A with diaeresis
    0x106 => 'C', 0x107 => 'c', # letter C with acute
    0x10c => 'C', 0x10d => 'c', # letter C with caron
    0x10e => 'D', 0x10f => 'd', # letter D with caron
    0x118 => 'E', 0x119 => 'e', # letter E with ogonek
    0x0c9 => 'E', 0x0e9 => 'e', # letter E with acute
    0x11a => 'E', 0x11b => 'e', # letter E with caron
    0x0cd => 'I', 0x0ed => 'i', # letter I with acute
    0x141 => 'L', 0x142 => 'l', # letter L with stroke
    0x139 => 'L', 0x13a => 'l', # letter L with acute
    0x13d => 'L', 0x13e => 'l', # letter L with caron
    0x143 => 'N', 0x144 => 'n', # letter N with acute
    0x147 => 'N', 0x148 => 'n', # letter N with caron
    0x0d3 => 'O', 0x0f3 => 'o', # letter O with acute
    0x0d4 => 'O', 0x0f4 => 'o', # letter O with circumflex
    0x154 => 'R', 0x155 => 'r', # letter R with acute
    0x158 => 'R', 0x159 => 'r', # letter R with caron
    0x15a => 'S', 0x15b => 's', # letter S with acute
    0x160 => 'S', 0x161 => 's', # letter S with caron
    0x164 => 'T', 0x165 => 't', # letter T with caron
    0x0da => 'U', 0x0fa => 'u', # letter U with acute
    0x16e => 'U', 0x16f => 'u', # letter U with ring above
    0x0dd => 'Y', 0x0fd => 'y', # letter Y with acute
    0x179 => 'Z', 0x17a => 'z', # letter Z with acute
    0x17b => 'Z', 0x17c => 'z', # letter Z with dot above
    0x17d => 'Z', 0x17e => 'z', # letter Z with caron
);

sub _encoding_fallback
{
    my ($u) = @_;
    return
      $_encoding_fallback{$u}
      // sprintf('<U+%04X>', $u);
}

sub bytes_to_unicode
{
    my ($u, $encoding) = @_;
    $encoding //= 'locale';
    return Encode::decode($encoding, $u);
}

sub unicode_to_bytes
{
    my ($s, $encoding) = @_;
    $encoding //= 'locale';
    return Encode::encode($encoding, $s, \&_encoding_fallback);
}

my %country_to_language = (
    cz => 'cs',  # Czech Republic => Czech
    pl => 'pl',  # Poland => Polish
    sk => 'sk',  # Slovakia => Slovak
);

my @known_countries = keys(%country_to_language);

# =============
# HTTP, SSL/TLS
# =============

my $ua = undef;

my $http_product_name = 'Mozilla/5.0 (Windows NT 6.1; rv:17.0) Gecko/20100101 Firefox/17.0';
my $http_read_size_hint = 1 << 20;  # 1 MiB
my $http_timeout = 30;

sub http_init
{
    my %options = @_;
    my $host = delete $options{host}
        // internal_error('missing host');
    my $cookie_jar_path = delete $options{cookie_jar}
        // internal_error('missing cookie_jar');
    my $ca_path = delete $options{ca}
        // internal_error('missing ca');
    check_for_unexpected_options(%options);
    if ($Net::HTTPS::SSL_SOCKET_CLASS ne 'IO::Socket::SSL') {
        # should not happen, but better safe than sorry
        internal_error("\$Net::HTTPS::SSL_SOCKET_CLASS == $Net::HTTPS::SSL_SOCKET_CLASS")
    };
    for my $key (grep { m/^HTTPS_/ } keys(%ENV)) {
        # https://bugs.debian.org/746579
        delete $ENV{$key};
    }
    my @ssl_options = (
        SSL_cipher_list => 'HIGH:!aNULL:!eNULL',
        SSL_ca_file => $ca_path,
#        SSL_ca_path => \undef,
        SSL_verify_mode => 1,
        SSL_verifycn_name => $host,
        SSL_verifycn_scheme => {
            check_cn => 0,
            wildcards_in_alt => 0,
            wildcards_in_cn => 0,
            ip_in_cn => 0,
            # FIXME: LWP::protocol::https (>= 6.0) stomps on SSL_verifycn_scheme
            # https://bugs.debian.org/747225
        },
    );
    IO::Socket::SSL::set_ctx_defaults(@ssl_options);
    my @cookie_jar_options = (
        ignore_discard => 1,
        hide_cookie2 => 1,
        parse_head => 0,
    );
    if ($cookie_jar_path ne '/dev/null') {
        # TODO: implement auto-logout if cookie jar is /dev/null
        push(@cookie_jar_options,
            file => $cookie_jar_path,
            autosave => 1,
        );
    };
    my $cookie_jar = HTTP::Cookies->new(@cookie_jar_options);
    my $ua = LWP::UserAgent->new(  ## no critic (ReusedNames)
        agent => $http_product_name,
        cookie_jar => $cookie_jar,
        protocols_allowed => ['https'],
        timeout => $http_timeout,
        keep_alive => 1,
    );
    if ($IO::Socket::SSL::VERSION >= 1.969) {
        IO::Socket::SSL::set_args_filter_hack('use_defaults');
    } elsif ($LWP::UserAgent::VERSION >= 6) {
        $ua->ssl_opts(
            verify_hostname => 1,
            @ssl_options,
        )
    };
    $ua->default_header(
        'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
        'Accept-Encoding' => 'gzip, deflate',
    );
    return $ua;
}

sub download
{
    my ($request) = @_;
    my $message = sprintf(
        '%s %s',
        $request->method,
        $request->uri
    );
    debug($message);
    my $response = $ua->request($request, undef, $http_read_size_hint);
    $response->decode()
        // http_decoding_error($request);
    my $content = $response->content;
    $content =~ s/\r//g;
    if (defined($opt_debug_dir)) {
        my $is_json = $response->headers->content_type() eq 'application/json';
        my $default_ext = $is_json ? 'json' : 'html';
        my $path = $request->uri;
        $path =~ s{^\w+://.*?/}{};
        $path =~ s/[?].*//;
        $path =~ s/[^[:alnum:].]/_/g;
        $path =~ s/(?:[.]\w+)?$/.$default_ext/;
        if ($path eq '.html') {
            $path = 'index.html';
        }
        $path = "$opt_debug_dir/$path";
        open(my $fh, '>', "$path")
            or os_error("$path: $ERRNO");
        print {$fh} $content;
        close($fh)
            or os_error("$path: $ERRNO");
        my $rpath = "${path}.request";
        open(my $fh, '>', $rpath)
            or os_error("$rpath: $ERRNO");
        print {$fh} $request->dump(maxlength => 1);
        close($fh)
            or os_error("$rpath: $ERRNO");
    }
    if (not $response->is_success) {
        http_error($request, $response);
    }
    $content = $response->decoded_content()
        // http_decoding_error($request);
    my $url = $response->request->uri;
    return {
        response => $response,
        content => $content,
        url => $url,
    };
}

sub simple_download
{
    my ($request) = @_;
    my $message = sprintf(
        'simple %s %s',
        $request->method,
        $request->uri
    );
    debug($message);
    my $response = $ua->simple_request($request, undef, $http_read_size_hint);
    if ($response->is_error) {
        http_error($request, $response);
    }
    $response->decode()
        // http_decoding_error($request);
    return $response;
}

sub get_default_ca_path
{
    my ($name, @hashes) = @_;
    my $filename = "$name.crt";
    $filename =~ y/ /_/;
    my $path = "/usr/share/ca-certificates/mozilla/$filename";
    if (-r $path) {
        return $path;
    }
    my $ssl_cert_dir = $ENV{SSL_CERT_DIR};
    if (not defined $ssl_cert_dir) {
        # https://www.openssl.org/docs/crypto/SSLeay_version.html
        # SSLEAY_DIR == 5
        my $openssl_info = Net::SSLeay::SSLeay_version(5);
        my ($openssl_dir) = $openssl_info =~ m/\AOPENSSLDIR: "(.*)"\Z/;
        if (defined($openssl_dir)) {
            $ssl_cert_dir = "$openssl_dir/certs";
        }
    }
    if (defined($ssl_cert_dir)) {
        for my $hash (@hashes) {
            $path = "$ssl_cert_dir/$hash.0";
            # TODO: actually check if this is the certificate we want
            # hash collisions are unlikely, but not impossible
            -r $path or next;
            my $rpath = readlink($path) or next;
            $rpath =~ m{\A/}
                or $rpath = "$ssl_cert_dir/$rpath";
            return $rpath;
        }
    }
    my $here = dirname(__FILE__);
    $path = File::Spec->catfile($here, 'ca.crt');
    return $path;
}

# ===========================
# configuration file handling
# ===========================

sub read_config
{
    my ($path) = @_;
    open(my $fh, '<', $path)
        or os_error("$path: $ERRNO");
    my $config = _read_config($fh, $path);
    close($fh)
        or os_error("$path: $ERRNO");
    return $config;
}

sub _read_config
{
    my ($fh, $path) = @_;
    my $pgp = undef;
    my $config = {
        __pgp__ => [],
        __path__ => $path,
    };
    while (<$fh>) {
        chomp;
        if (defined($pgp)) {  ## no critic (CascadingIfElse)
            $pgp .= "$_\n";
            if ($_ eq '-----END PGP MESSAGE-----') {
                push(@{$config->{__pgp__}}, $pgp);
                $pgp = undef;
            }
        } elsif ($_ eq '-----BEGIN PGP MESSAGE-----') {
            $pgp = "$_\n";
        } elsif (m/^(?:#|\s*)$/) {
            next;
        } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
            my ($key, $value) = ($1, $2);
            $key = lc($key);
            ($value) = Text::ParseWords::parse_line('^$', 0, $value);
            $config->{$key} = $value;
        } else {
            config_error($path, "syntax error: $_");
        }
    }
    return $config;
}

sub _decrypt_config
{
    my ($config) = @_;
    my $pgp_chunks = delete $config->{__pgp__};
    defined($pgp_chunks) or return;
    for my $encrypted_data (@{$pgp_chunks}) {
        my $decrypted_data;
        IPC::Run::run(
            ['gpg', '-d'],
            '<', \$encrypted_data,
            '>', \$decrypted_data,
        ) or os_error('gpg -d failed');
        my @decrypted_data = split(/\n/, $decrypted_data);
        for (@decrypted_data) {
            if (m/^(?:#|\s*)$/) {
                next;
            } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
                my ($key, $value) = ($1, $2);
                $key = lc($key);
                ($value) = Text::ParseWords::parse_line('^$', 0, $value);
                $config->{$key} = $value;
            } else {
                config_error($config, "syntax error in encrypted part: $_");
            }
        }
    }
    return $config;
}

sub get_config_var
{
    my ($config, $var, $default) = @_;
    if (exists($config->{$var}) or defined($default)) {
        if (ref($default)) {
            $default = ${$default};
        }
        return $config->{$var} // $default;
    }
    _decrypt_config($config);
    return $config->{$var};
}

# ============
# misc parsing
# ============

sub format_amount
{
    my ($s, %options) = @_;
    my $use_plus = delete($options{plus});
    my $currency = delete($options{currency});
    check_for_unexpected_options(%options);
    my $sign_re;
    $s =~ s/\s+(?=\d)//g;
    if ($use_plus) {
        $sign_re = qr/[+-]?/;
    } else {
        $sign_re = qr/-?/;
    }
    my $amount_re = qr/($sign_re\d+[.,]\d{2})/;
    my $currency_re;
    if (defined $currency) {
        $currency =~ m/\A[A-Z]{3}\z/  ## no critic (EnumeratedClasses)
            or return;
        $currency_re = qr//;
    } else {
        $currency_re = qr/\s+([A-Z]{3})/;  ## no critic (EnumeratedClasses)
    }
    my ($amount, $parsed_currency) = ($s =~ m/\A$amount_re$currency_re\z/)
        or return;
    $amount =~ y/,/./;
    $currency //= $parsed_currency;
    return sprintf('%10s %s', $amount, $currency);
}

sub format_number
{
    my ($format, $n) = @_;
    my $s;
    eval {
        $s = sprintf($format, $n);
    } // return;
    return $s;
}

sub parse_timestamp
{
    my ($timestamp) = @_;
    my ($date, $time) = ($timestamp =~ m/\A(\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d[.]\d+)\z/)
        or return;
    return str2time($timestamp);
}

sub parse_le_date
{
    my ($date) = @_;
    my ($d, $m, $y) = ($date =~ m/\A(\d\d)-(\d\d)-(\d\d\d\d)\z/)
        or return;
    return str2time("$y-$m-$d");
}

sub format_timestamp
{
    my ($timestamp, %options) = @_;
    my $use_time = delete($options{time}) // 1;
    my $use_le = delete($options{le});
    my $use_unix = delete($options{unix});
    check_for_unexpected_options(%options);
    my $unix_timestamp;
    if ($use_unix) {
        $unix_timestamp = $timestamp;
    } elsif ($use_le) {
        $unix_timestamp = parse_le_date($timestamp)
    } else {
        $unix_timestamp = parse_timestamp($timestamp)
    }
    defined($unix_timestamp)
        or return;
    my $date = time2str('%Y-%m-%d', $unix_timestamp)
        // return;
    if (not $use_time) {
        return $date;
    }
    my $time = time2str('%H:%M:%S', $unix_timestamp)
        // return;
    if (my ($frac_seconds) = ($unix_timestamp =~ /[.](\d+)\z/)) {
        # fractional seconds are boring
    } elsif ($time =~ /\A[\d:]+\z/) {
        # exactly-midnight times are boring
        return $date;
    }
    return "${date}T${time}";
}

sub wildcards_to_regexp
{
    my (@wildcards) = @_;
    my $re = join('|',
        map { quotemeta($_) } @wildcards
    );
    $re =~ s/\\[*]/.*/g;
    $re = qr{^(?i:($re))$};
    return $re;
}

sub html_class_regexp
{
    my ($class) = @_;
    return qr/(?:\A|\s)\Q$class\E(?:\s|\z)/;
}

sub find_html_class
{
    my ($element, $class) = @_;
    my $re = html_class_regexp($class);
    return $element->look_down('class', $re);
}

sub decode_json
{
    my ($json) = @_;
    return eval {
        JSON::decode_json($json);
    } // return;
}

# =======================
# command implementations
# =======================

my $mbank_host = undef;
my $base_url = undef;
my $csite_url = undef;

my @json_headers = (
    'Accept' => 'application/json, text/javascript, */*; q=0.01',
    'Content-Type' => 'application/json; charset=UTF-8',
    'X-Requested-With' => 'XMLHttpRequest',
);

my @ajax_html_headers = (
    'Accept' => 'text/html, */*; q=0.01',
    'Content-Type' => 'application/x-www-form-urlencoded; charset=UTF-8',
    'X-Requested-With' => 'XMLHttpRequest',
);

sub do_login
{
    my %options = @_;
    my $cfg = delete($options{config});
    check_for_unexpected_options(%options);
    my $request = GET($base_url);
    my $doc = download($request);
    if ($doc->{url} =~ m{/Login$}) {
        if (not defined($cfg)) {
            debug('not logged in');
            return;
        }
        debug('logging in...');
        my ($seed) = ($doc->{content} =~ m/entrypoint[.]initialize[(]'([\w=-]+)'[)]/)
            or scraping_error('login.seed');
        my $login_url = $doc->{url};
        my $login = get_config_var($cfg, 'login')
            // config_error($cfg, 'missing login');
        my $password = get_config_var($cfg, 'password')
            // config_error($cfg, 'missing password');
        $request = POST(
            "$base_url/LoginMain/Account/JsonLogin",
            @json_headers,
            'Referer' => $login_url,
            'Content' => encode_json({
                UserName => $login,
                Password => $password,
                Seed => $seed,
                Lang => '',
            }),
        );
        $doc = download($request);
        my $login_json = decode_json($doc->{content})
            // scraping_error("login.json: $EVAL_ERROR");
        if ($login_json->{successful}) {
            $request = GET($base_url);
            $doc = download($request);
        } else {
            my $message = $login_json->{errorMessageTitle} // 'unknown error';
            user_error("login failed: $message");
        }
    }
    my $tabid = undef;
    $ua->cookie_jar->scan(
        sub {
            my ($version, $key, $value, $path, $domain) = @_;
            if (($domain eq $mbank_host) and ($key eq 'mBank_tabId')) {
                $tabid = $value;
            }
        }
    );
    defined($tabid)
        or scraping_error('login.tabid');
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my @e_meta = $html->look_down(
        _tag => 'meta',
        name => '__AjaxRequestVerificationToken'
    );
    scalar(@e_meta) == 1
        or scraping_error('login.arvt.n' . scalar(@e_meta));
    my ($e_meta) = @e_meta;
    my $arvt = $e_meta->attr('content');
    $arvt =~ m{\A[\w/+]{100,}\z}
        or scraping_error("login.arvt: $arvt");
    my %menu = ();
    for my $e_script ($html->look_down(_tag => 'script')) {
        my @content = $e_script->content_list;
        scalar(@content) == 1
            or next;
        my ($content) = @content;
        if (ref $content) {
            next;
        }
        my ($js) = ($content =~ m/\A\s*nmbMenu\s*=\s*({.+})\s*\z/s)
            or next;
        $js =~ s/'/"/g;
        $js =~ s/(\w+):/"$1":/g;
        $js =~ s/,\s*}/}/g;
        my $json = decode_json($js)
            or scraping_error("login.menu.json: $EVAL_ERROR");
        while (my ($key, $value) = each %{$json}) {
            $key =~ m/\A\w+\z/
                or scraping_error("login.menu.key: $key");
            my $url = $value->{url} // '';
            $url =~ m{\A/\S+\z}
                or scraping_error("login.menu.url: $url");
            $menu{$key} = $url;
        }
        last;
    }
    debug('logged in');
    return {
        tabid => $tabid,
        arvt => $arvt,
        menu => \%menu,
        url => $doc->{url},
    };
}

sub do_list
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $quiet = delete($options{quiet}) // 0;
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/MyDesktop/Desktop/GetAccountsList",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '{}',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("list.json: $EVAL_ERROR");
    my @accounts = @{$json->{accountDetailsList}};
    my @result;
    for my $account (@accounts) {
        my $name = $account->{ProductName}
            // scraping_error('list.product-name');
        my $subtitle = $account->{SubTitle} // '';
        if ($subtitle ne '') {
            $name .= " - $subtitle";
        }
        my $number = $account->{AccountNumber}
            // scraping_error('list.account-number');
        push(@result, {
            name => $name,
            number => $number,
        });
        next if $quiet;
        my $balance = $account->{Balance}
            // scraping_error('list.balance');
        my $available = $account->{AvailableBalance}
            // scraping_error('list.available');
        my $currency = $account->{Currency}
            // scraping_error('list.currency');
        $balance = format_amount($balance, currency => $currency)
            // scraping_error("list.balance: $balance $currency");
        $available = format_amount($available, currency => $currency)
            // scraping_error("list.available: $available $currency");
        $name = unicode_to_bytes($name);
        print("$name\t$number\t$balance\t$available\n");
    }
    return [@result];
}

sub select_accounts
{
    my ($account_info, @selection) = @_;
    my $regexp = wildcards_to_regexp(
        map { bytes_to_unicode $_ } @selection
    );
    my %result = ();
    for my $account (@{$account_info}) {
        my $name = $account->{name};
        my $number = $account->{number};
        if ($name =~ $regexp) {
            debug("selected account: $number");
            $result{$number} = $name;
        } else {
            debug("deselected account: $number");
        }
    }
    return %result;
}

sub _clean_history_form
{
    my ($form, %options) = @_;
    my $parameters = delete($options{'params'});
    my $reset = delete($options{'reset'});
    check_for_unexpected_options(%options);
    for my $input ($form->inputs) {
        if ($input->name =~ m/\Alastdays_\w+\z/) {
            $input->disabled(1);
        }
        if ($reset and $input->name !~ m/\A__/) {
            $input->disabled(1);
        }
    }
    if (defined($parameters)) {
        $form->value('__PARAMETERS', $parameters);
    }
    return;
}

sub _prepare_history
{
    my ($login_info) = @_;
    my $module = 'account_oper_list';
    my $frameset_url = "frames.aspx?module=$module";
    my $menu_url = $login_info->{menu}->{hosthistory} // '';
    $menu_url eq "/csite/$frameset_url"  # sanity check
        or scraping_error('history.menu: ' . $menu_url);
    my $request = GET(
        "$csite_url/$frameset_url",
        'Referer' => $login_info->{url},
    );
    my $doc = download($request);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my @e_frames = $html->look_down(
        _tag => 'frame',
        name => 'MainFrame',
    );
    scalar(@e_frames) == 1
        or scraping_error('history.frame');
    my ($e_frame) = @e_frames;
    my $frame_url = $e_frame->attr('src') // '';
    $frame_url =~ s/\A\s+|\s+\z//g;
    $frame_url eq "$module.aspx"  # sanity check
        or scraping_error("history.frame.url: $frame_url");
    $request = GET(
        "$csite_url/$frame_url",
        'Referer' => $doc->{url},
    );
    $doc = download($request);
    return $doc;
}

sub do_history
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $account_info = delete($options{accounts})
        // internal_error('missing account info');
    my $selection = delete($options{selection})
        // internal_error('missing selection');
    my @selection = @{$selection};
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    my $start_date = delete($options{start_date});
    my $end_date = delete($options{end_date});
    check_for_unexpected_options(%options);
    my $doc = _prepare_history($login_info);
    my %selected_accounts = select_accounts($account_info, @selection);
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    for my $number (sort keys %selected_accounts) {
        $doc = _do_history_account(
            document => $doc,
            number => $number,
            name => $selected_accounts{$number},
            display_name => $display_name,
            start_date => $start_date,
            end_date => $end_date,
        );
    }
    return;
}

sub _switch_history_account
{
    my %options = @_;
    my $doc = delete($options{document})
        // internal_error('missing document');
    my $number = delete($options{'number'})
        // internal_error('missing account number');
    check_for_unexpected_options(%options);
    my $parameters = undef;
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my @e_account_menu = $html->look_down(id => 'MenuAccountsCombo');
    scalar(@e_account_menu) == 1
        or scraping_error('history.account-menu');
    my ($e_account_menu) = @e_account_menu;
    my @e_accounts = $e_account_menu->content_list();
    for my $e_account (@e_accounts) {
        my $o_name = $e_account->as_trimmed_text();
        my ($o_number) = ($o_name =~ m/- (\d{2}(?: \d{4}){6})\z/)
            or scraping_error("history.account.number: $o_name");
        if ($number eq $o_number) {
            if ($e_account->attr('selected')) {
                $parameters = ''
            } else {
                $parameters = $e_account->attr('value');
            }
            last;
        }
    }
    defined($parameters)
        or scraping_error("history.account.phantom: $number");
    if (length($parameters) > 0) {
        my @forms = HTML::Form->parse($doc->{response});
        scalar(@forms) == 1
            or scraping_error('history.form.n: ' . scalar(@forms));
        my ($form) = @forms;
        _clean_history_form($form, params => $parameters);
        $doc = download($form->click());
    }
    return $doc;
}

sub _do_history_account
{
    my %options = @_;
    my $doc = delete($options{document})
        // internal_error('missing document');
    my $name = delete($options{'name'})
        // internal_error('missing account name');
    my $number = delete($options{'number'})
        // internal_error('missing account number');
    my $start_date = delete($options{start_date});
    my $end_date = delete($options{end_date});
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    $doc = _switch_history_account(
        document => $doc,
        number => $number,
    );
    my @forms = HTML::Form->parse($doc->{response});
    scalar(@forms) == 1
        or scraping_error('history.form.n: ' . scalar(@forms));
    my ($form) = @forms;
    if (defined($start_date) or defined($end_date)) {
        my $min_date = '1901-01-01';
        my $get_limit = sub {
            my ($var) = @_;
            my $min_date_nh = $min_date;
            $min_date_nh =~ s/-//g;
            my $regexp = qr{\bDateValidator[(]theform[.]daterange_\Q$var\E_day, '\Q$min_date_nh\E', '(\d\d\d\d)(\d\d)(\d\d)', '', ''[)]};
            my @limit = ($doc->{content} =~ $regexp)
                or return;
            return join('-', @limit);
        };
        my $set_date = sub {
            my ($var, $date) = @_;
            $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
                or internal_error("invalid date: $date");
            my ($y, $m, $d) = split(m/-/, $date);
            $m =~ s/\A0//;
            $d =~ s/\A0//;
            $form->value("daterange_${var}_day", $d);
            $form->value("daterange_${var}_month", $m);
            $form->value("daterange_${var}_year", $y);
            $form->value('rangepanel_group', 'daterange_radio');
            return;
        };
        my $now = my $start_limit = $get_limit->('from')
            // scraping_error('history.limit.start');
        my $end_limit = $get_limit->('to')
            // scraping_error('history.limit.end');
        # start date:
        $start_date //= $now;
        $min_date le $start_date
            or user_error('--from date too far in the past');
        $start_date le $start_limit
            or user_error('--from date in the future');
        $set_date->('from', $start_date);
        # end date:
        $end_date //= $now;
        $min_date le $end_date
            or user_error('--to date too far in the past');
        $end_date le $end_limit
            or user_error('--to date too far in the future');
        $start_date le $end_date
            or user_error('--to date before --from date');
        $set_date->('to', $end_date);
    }
    _clean_history_form($form);
    $doc = download($form->click());
    PAGE: while (1) {
        my $html = HTML::TreeBuilder->new_from_content($doc->{content});
        _do_history_page(
            html => $html,
            name => $name,
            display_name => $display_name,
        );
        my @e_prevpage = $html->look_down(
            _tag => 'button',
            id => 'PrevPage',
        );
        scalar(@e_prevpage) <= 1
            or scraping_error('history.prev.n: ' . scalar(@e_prevpage));
        if (@e_prevpage) {
            my ($e_prevpage) = @e_prevpage;
            my $onclick = $e_prevpage->attr('onclick');
            my $url = $doc->{response}->base;
            $url =~ s{\A.*?(?=/csite/)}{};
            my ($parameters) = ($onclick =~ m{\AdoSubmit[(]'\Q$url\E','','POST','([^']*)',true,false,true,null[)];})
                or scraping_error('history.prev.onclick');
            @forms = HTML::Form->parse($doc->{response});
            scalar(@forms) == 1
                or scraping_error('history.prev.form.n: ' . scalar(@forms));
            ($form) = @forms;
            _clean_history_form($form, params => $parameters);
            $doc = download($form->click());
            next PAGE;
        } else {
            last PAGE;
        }
    }
    return $doc;
}

sub _do_history_page {
    my %options = @_;
    my $html = delete($options{html})
        // internal_error('missing html');
    my $name = delete($options{name})
        // internal_error('missing name');
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    my @e_op_descs = find_html_class($html, 'OperationDescription');
    if (not @e_op_descs) {
        $html->look_down(id => 'account_operations_NoData')
            or scraping_error('history.empty');
        return;
    }
    for my $e_op_desc (@e_op_descs) {
        my $e_op = $e_op_desc->parent;
        $e_op->tag eq 'li'
            or scraping_error('history.table');
        my $class = $e_op->attr('class');
        $class !~ html_class_regexp('header')
            or next;
        # dates:
        my @e_dates = find_html_class($e_op, 'Date');
        scalar(@e_dates) == 1
            or scraping_error('history.date.1');
        my ($e_dates) = @e_dates;
        @e_dates = $e_dates->content_list();
        scalar(@e_dates) == 2
            or scraping_error('history.date.2');
        my @dates = ();
        for my $e_date (@e_dates) {
            my $date = $e_date->as_trimmed_text();
            $date = format_timestamp($date, le => 1)
                // scraping_error("history.date: $date");
            push(@dates, $date);
        }
        # amounts:
        my @e_amounts = find_html_class($e_op, 'Amount');
        scalar(@e_amounts) == 2
            or scraping_error('history.amount.n');
        my @amounts;
        for my $e_amount (@e_amounts) {
            my $amount = $e_amount->as_trimmed_text();
            $amount = format_amount($amount)
                // scraping_error("history.amount: $amount");
            push(@amounts, $amount);
        }
        # details:
        my @e_details = $e_op_desc->content_list();
        scalar(@e_details) >= 3
            or scraping_error('history.details.n');
        my @details;
        for my $e_detail (@e_details) {
            $class = $e_detail->attr('class');
            if ($class =~ html_class_regexp('FilterType')) {
                next;
            }
            my $detail = $e_detail->as_trimmed_text();
            $detail =~ s/\N{SOFT HYPHEN}//g;
            push(@details, $detail);
        }
        # print:
        {
            local $LIST_SEPARATOR = "\t";
            if ($display_name) {
                print("$name\t");
            }
            print("@dates\t@amounts\t@details\n");
        }
    }
    return;
}

sub _prepare_blocked
{
    my ($login_info) = @_;
    my $doc = _prepare_history($login_info);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my $module = 'witholdings_list';
    my $url = "/csite/$module.aspx";
    $html->look_down(
        _tag => 'a',
        onclick => qr/\A\QdoSubmit('$url','','POST','',false,true,false,null);\E/,
    )
        or scraping_error('blocked.module');
    my @forms = HTML::Form->parse($doc->{response});
    scalar(@forms) == 1
        or scraping_error('blocked.form.n: ' . scalar(@forms));
    my ($form) = @forms;
    _clean_history_form($form,
        params => '',
        reset => 1
    );
    $form->action("$csite_url/$module.aspx");
    $doc = download($form->click);
    return $doc;
}

sub do_blocked
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $account_info = delete($options{accounts})
        // internal_error('missing account info');
    my $selection = delete($options{selection})
        // internal_error('missing selection');
    my @selection = @{$selection};
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    my $doc = _prepare_blocked($login_info);
    my %selected_accounts = select_accounts($account_info, @selection);
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    for my $number (sort keys %selected_accounts) {
        $doc = _do_blocked_account(
            document => $doc,
            number => $number,
            name => $selected_accounts{$number},
            display_name => $display_name,
        );
    }
    return;
}

sub _do_blocked_account
{
    my %options = @_;
    my $doc = delete($options{document})
        // internal_error('missing document');
    my $name = delete($options{'name'})
        // internal_error('missing account name');
    my $number = delete($options{'number'})
        // internal_error('missing account number');
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    $doc = _switch_history_account(
        document => $doc,
        number => $number,
    );
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my $nothing_blocked = $html->look_down(
        _tag => 'div',
        id => 'witholdingsListHoldings_NoData',
    );
    if ($nothing_blocked) {
        return;
    }
    my $e_blocked = $html->look_down(
        _tag => 'div',
        id => 'witholdingsListHoldings',
    );
    $e_blocked
        or scraping_error('blocked.table');
    my @e_ops = $e_blocked->look_down(_tag => 'li');
    @e_ops
        or scraping_error('blocked.table.n');
    for my $e_op (@e_ops) {
        my $class = $e_op->attr('class');
        $class !~ html_class_regexp('header')
            or next;
        # dates:
        my @e_dates = find_html_class($e_op, 'Date');
        scalar(@e_dates) == 2
            or scraping_error('blocked.date.n');
        my @dates = ();
        for my $e_date (@e_dates) {
            my $date = $e_date->as_trimmed_text();
            $date = format_timestamp($date, le => 1)
                // scraping_error("blocked.date: $date");
            push(@dates, $date);
        }
        # amount:
        my @e_amounts = find_html_class($e_op, 'Amount');
        scalar(@e_amounts) == 1
            or scraping_error('blocked.amount.n');
        my ($e_amount) = @e_amounts;
        my $amount = $e_amount->as_trimmed_text();
        $amount = format_amount($amount)
            // scraping_error("blocked.amount: $amount");
        # description:
        my @e_descriptions = find_html_class($e_op, 'WitholdingDescription');
        scalar(@e_descriptions) == 1
            or scraping_error('blocked.description.n');
        my ($e_description) = @e_descriptions;
        my $description = $e_description->as_trimmed_text();
        # type:
        my @e_types = find_html_class($e_op, 'WitholdingType');
        scalar(@e_types) == 1
            or scraping_error('blocked.type.n');
        my ($e_type) = @e_types;
        my $type = $e_type->as_trimmed_text();
        # print:
        {
            local $LIST_SEPARATOR = "\t";
            if ($display_name) {
                print("$name\t");
            }
            print("@dates\t$amount\t$description\t$type\n");
        }
    }
    return;
}

sub do_future
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $account_info = delete($options{accounts})
        // internal_error('missing account info');
    my $selection = delete($options{selection})
        // internal_error('missing selection');
    my @selection = @{$selection};
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/FutureOperations/Calendar/OPER_GetFutureTransfers",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '{"getFilter":true}',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("future.json: $EVAL_ERROR");
    my %selected_accounts = select_accounts($account_info, @selection);
    if (not %selected_accounts) {
        user_error('future: no matching accounts')
    }
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    my $transfer_info = $json->{transferInfos}
        // scraping_error('future.transfer');
    for my $transfer (@{$transfer_info}) {
        my $number = $transfer->{accountNumber}
            // scraping_error('future.transfer.account-number');
        my $name = $selected_accounts{$number};
        defined($name) or next;
        if ($display_name) {
            print("$name\t");
        }
        my $timestamp = $transfer->{date};
        $timestamp = format_timestamp($timestamp)
            // scraping_error('future.transfer.date');
        my $recipient = $transfer->{benef}
            // scraping_error('future.transfer.recipient');
        for my $key (qw(benefAddress benefCity)) {
            my $recipient_loc = $transfer->{$key} // '';
            if (length($recipient_loc) > 0) {
                $recipient .= "; $recipient_loc";
            }
        }
        my $description = $transfer->{description}
            // scraping_error('future.transfer.description');
        $description = unicode_to_bytes($description);
        my $amount = $transfer->{amount}
            // scraping_error('future.transfer.amount');
        my $currency = $transfer->{currency}
            // scraping_error('future.transfer.currency');
        $amount = format_amount($amount, currency => $currency)
            // scraping_error("future.transfer.amount: $amount $currency");
        my $status = $transfer->{transferType}
            // scraping_error('future.transfer.type');
        print("$timestamp\t$recipient\t$description\t$amount\t$status\n");
    }
    return;
}

sub do_deposits
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/Savings/Deposits/getDepositsList",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("deposits.json: $EVAL_ERROR");
    $json = $json->{properties}
        // scraping_error('deposits.properties');
    $json->{footer}->{isListComplete}
        or scraping_error('deposits.incomplete');
    my $deposits = $json->{deposits};
    my $seconds_in_day = 60 * 60 * 24;
    for my $deposit (@{$deposits}) {
        my $title = $deposit->{title}
            // scraping_error('deposits.title');
        $title = unicode_to_bytes($title);
        my $type = $deposit->{type}
            // scraping_error('deposits.type');
        $type = unicode_to_bytes($type);
        my $end_date = $deposit->{endDate} // '';
        $end_date = parse_timestamp($end_date)
            // scraping_error("deposits.end-date: $end_date");
        my $duration_in_days = $deposit->{durationInDays} // '';
        $duration_in_days =~ m/\A\d+\z/
            or scraping_error('deposits.duration-in-days');
        my $start_date = $end_date - $duration_in_days * $seconds_in_day;
        $start_date = format_timestamp($start_date, unix => 1)
            // scraping_error("deposits.start-date.unix: $start_date");
        $end_date = format_timestamp($end_date, unix => 1)
            // scraping_error("deposits.end-date.unix: $end_date");
        my $duration = $deposit->{period}
            // scraping_error('deposits.duration');
        $duration = unicode_to_bytes($duration);
        my $interest = $deposit->{interestRate} // '';
        $interest = format_number('%.2f', $interest)
            // scraping_error("deposits.interest: $interest");
        my $amount = $deposit->{startValue} // '';
        my $currency = $deposit->{currency} // '';
        $amount = format_number('%.2f', $amount)
            // scraping_error("deposits.amount: $amount");
        $amount = format_amount($amount, currency => $currency)
            // scraping_error("deposits.amount: $amount $currency");
        print("$title\t$type\t$start_date\t$end_date\t$duration\t$interest%\t$amount\n");
    }
    return;
}

sub do_cards
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/Cards/Cards/IndexData",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @ajax_html_headers,
        'Referer' => $login_info->{url},
        Content => '',
    );
    my $doc = download($request);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my @e_cards = find_html_class($html, 'card-properties');
    for my $e_card (@e_cards) {
        my $e_name = find_html_class($e_card, 'card-name')
            // scraping_error('cards.name');
        my $name = $e_name->as_trimmed_text();
        my $e_number = find_html_class($e_card, 'card-number')
            // scraping_error('cards.number');
        my $number = $e_number->as_trimmed_text();
        my $e_owner = find_html_class($e_card, 'card-owner')
            // scraping_error('cards.owner');
        my $owner = $e_owner->as_trimmed_text();
        my $e_amount = find_html_class($e_card, 'card-amount')
            // scraping_error('cards.amount');
        my $amount = $e_amount->as_trimmed_text();
        $amount = format_amount($amount)
            or scraping_error("cards.amount: $amount");
        print("$name\t$number\t$owner\t$amount\n");
    }
    return;
}

sub do_funds
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/InvestmentFunds/Dashboard/Dashboard",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @ajax_html_headers,
        'Referer' => $login_info->{url},
        Content => '',
    );
    my $doc = download($request);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my @e_funds = find_html_class($html, 'investment-properties');
    for my $e_fund (@e_funds) {
        my $class = $e_fund->attr('class');
        if ($class =~ html_class_regexp('wallet-properties')) {
            next;
        }
        my $e_name = find_html_class($e_fund, 'investment-name-group')
            // scraping_error('funds.name');
        my $name = $e_name->as_trimmed_text();
        $name = unicode_to_bytes($name);
        my $e_amounts = find_html_class($e_fund, 'investment-actual')
            // scraping_error('funds.amount');
        my @e_amounts = $e_amounts->look_down(_tag => 'span');
        my $n_amounts = scalar(@e_amounts);
        ($n_amounts == 1) or ($n_amounts == 2)
            or scraping_error('funds.amount.n');
        my ($e_current_amount, $e_planned_amount) = @e_amounts;
        my $current_amount = $e_current_amount->as_trimmed_text();
        $current_amount = format_amount($current_amount)
            or scraping_error("funds.amount.current: $current_amount");
        my $planned_amount = undef;
        if (defined($e_planned_amount)) {
            $e_planned_amount->attr('class') =~ html_class_regexp('gray')
                or scraping_error('funds.amount.planned.gray');
            $planned_amount = $e_planned_amount->as_trimmed_text();
            $planned_amount = format_amount($planned_amount, plus => 1)
                or scraping_error("cards.amount.planned: $planned_amount");
        }
        my $line = "$name\t$current_amount";
        if (defined($planned_amount)) {
            $line .= "\t$planned_amount";
        }
        print("$line\n");
    }
    return;
}

sub do_notices
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/WhirlWind/AdvPlaceholder/GetUpdates",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '{"placeholderIdList":null,"timestamp":-1}',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("notices.json: $EVAL_ERROR");
    my $elements = $json->{Elements}
        // scraping_error('notices.elements');
    for my $element (@{$elements}) {
        my $template_path = $element->{TemplatePath}
            // scraping_error('notices.template-path');
        my $message = $element->{Message}
            // scraping_error('notices.message');
        my $is_hidden = $message->{IsHidden}
            // scraping_error('notices.is-hidden');
        my $is_visible = (
            $template_path =~ m{/MessageBox/|/TopAdmin/}
            and not $is_hidden
        );
        $is_visible or next;
        my $is_read = $message->{IsRead}
            // scraping_error('notices.is-read');
        my $new_flag = $is_read ? '' : 'N';
        my $timestamp = $message->{StartDate};
        $timestamp = format_timestamp($timestamp, time => 0)
            // scraping_error('notices.date');
        my $title = $message->{Title}
            // scraping_error('notices.title');
        $title = unicode_to_bytes($title);
        print("$new_flag\t$timestamp\t$title\n");
    }
    return;
}

sub do_logout
{
    my %options = @_;
    my $login_info = do_login();
    if (not defined($login_info)) {
        user_error('logout: the user was not logged in')
    } else {
        debug('logging out...');
        my $request = POST(
            "$base_url/LoginMain/Account/LazyLogout",
            'X-Tab-Id' => $login_info->{tabid},
            'X-Request-Verification-Token' => $login_info->{arvt},
            @json_headers,
            'Referer' => $login_info->{url},
        );
        my $doc = download($request);
        my $json = decode_json($doc->{content})
            // scraping_error("logout.json: $EVAL_ERROR");
        $json->{lazy}
            or scraping_error('logout.lazy');
        $request = GET(
            "$base_url/LoginMain/Account/Logout",
            'Referer' => $login_info->{url},
        );
        my $response = simple_download($request);
        $response->is_redirect
            or scraping_error('logout.redirect');
        debug('successful logout');
    }
    $ua->cookie_jar->clear();
    debug('cookies have been wiped out');
    return;
}

sub do_debug_noop
{
    # Nothing to do!
}

sub do_debug_https_get
{
    my %options = @_;
    my $urls = delete($options{args});
    check_for_unexpected_options(%options);
    my @urls = @{$urls};
    if (not @urls) {
        push(@urls, $base_url);
    }
    for my $url (@urls) {
        my $request = GET($url);
        my $doc = simple_download($request);
        print($doc->content());
    }
    return;
}

# ================================
# XDG Base Directory Specification
# ================================

sub xdg_config_home
{
    my $home = $ENV{XDG_CONFIG_HOME};
    if ($home !~ m{\A/}) {
        # “All paths […] must be absolute.
        # If an implementation encounters a relative path […]
        # it should consider the path invalid and ignore it.
        $home = "$ENV{HOME}/.config";
    }
    $home =~ s{[^/]\K/+\z}{};  # strip trailing slashes
    return $home;
}

# ============
# main program
# ============

my $xdg_config_home = xdg_config_home();
my $opt_config = "$xdg_config_home/mbank-cli/config";
my $opt_start_date = undef;
my $opt_end_date = undef;
my $opt_all = 0;
my $opt_multi = 0;

sub show_help
{
    print {*STDERR} <<'EOF' ;
Usage:
  mbank-cli [list]
  mbank-cli history [--from <start-date> [--to <end-date>]] {<account> | -M <account>... | -A}
  mbank-cli future {<account> | -M <account>... | -A}
  mbank-cli blocked {<account> | -M <account>... | -A}
  mbank-cli deposits
  mbank-cli funds
  mbank-cli cards
  mbank-cli notices
  mbank-cli logout

Common options:
  --verbose
  --debug <debug-directory>
  --config <config-file>
EOF
    exit();
}

sub check_user_date
{
    my ($option, $date) = @_;
    $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
        or user_error("--$option date not in the YYYY-MM-DD format: $date");
    str2time($date)
        // user_error("invalid --$option date: $date");
    return $date;
}

{
    local $SIG{__WARN__} = sub {
        my ($message) = @_;
        $message =~ s/\A([[:upper:]])/lc($1)/e;
        $message =~ s/\n+\z//;
        user_error($message);
    };
    GetOptions(
        'verbose' => \$opt_verbose,
        'debug=s' => \$opt_debug_dir,
        'config=s' => \$opt_config,
        'from=s' => sub {
            my ($option, $date) = @_;
            $opt_start_date = check_user_date($option, $date);
        },
        'to=s' => sub {
            my ($option, $date) = @_;
            $opt_end_date = check_user_date($option, $date);
        },
        'M|multiple-accounts' => \$opt_multi,
        'A|all-accounts' => \$opt_all,
        'h|help' => \&show_help,
    ) or user_error();
}

if (not -e $opt_config) {
    user_error("missing configuration file: $opt_config");
}
my $cfg = read_config($opt_config);
my $cookie_jar_path = get_config_var($cfg, 'cookiejar')
    // config_error($cfg, 'missing cookiejar');
my $ca_path = get_config_var($cfg, 'cafile', \undef)
    // get_default_ca_path(
        'Verisign Class 3 Public Primary Certification Authority',
        # openssl x509 -subject_hash -noout
        '415660c1',
        # openssl x509 -subject_hash_old -noout
        '7651b327',
    );
if (not -r $ca_path) {
    os_error("$ca_path: $ERRNO");
}
debug("cafile = $ca_path");
my $tld = get_config_var($cfg, 'country')
    // config_error($cfg, 'missing country');
$tld = lc $tld;
my $lang = $country_to_language{$tld};
if (not defined($lang)) {
    local $LIST_SEPARATOR = ', ';
    my $known_countries = "{@known_countries}";
    config_error($cfg, "unknown country $tld, not in $known_countries");
}

$mbank_host = $ENV{MBANK_CLI_HOST} // "online.mbank.$tld";
$base_url = "https://$mbank_host/$lang";
$csite_url = "https://$mbank_host/csite";

$ua = http_init(
    host => $mbank_host,
    cookie_jar => $cookie_jar_path,
    ca => $ca_path,
);

$ua->cookie_jar->scan(
    # sanity check
    sub {
        my ($version, $key, $value, $path, $domain) = @_;
        if ($domain ne $mbank_host) {
            user_error("$cookie_jar_path: unexpected domain $domain (!= $mbank_host)")
        }
    }
);

my ($command_name, @args) = @ARGV;
$command_name //= 'list';
debug("selected command: $command_name");

my %commands = (
    'debug-noop' => {},
    'debug-https-get' => {},
    'list' => {},
    'history' => { accounts => 1, dates => 1 },
    'future' => { accounts => 1 },
    'blocked' => { accounts => 1 },
    'deposits' => {},
    'cards' => {},
    'funds' => {},
    'notices' => {},
    'logout' => { login => 0 },
);

my $command_info = $commands{$command_name};
if (not defined $command_info) {
    user_error("$command_name: invalid command");
}
my $command;
{
    no strict 'refs';  ## no critic (NoStrict)
    my $sub_name = "do_$command_name";
    $sub_name =~ y/-/_/;
    $command = *{$sub_name};
}
my $need_login = $command_info->{login} // 1;
my @cmd_options;
if ($command_name =~ m/^debug-/) {
    $need_login = 0;
    push(@cmd_options,
        args => [@args],
    );
}
if ($command_info->{todo} ) {
    user_error("$command_name: command not implemented");
}
if ($command_info->{accounts}) {
    my @selection = @args;
    if ($opt_all) {
        @selection = '*';
    }
    if (scalar(@selection) < 1) {
        user_error("$command_name: no account selected");
    }
    push(@cmd_options,
        selection => [@selection],
        display_name => $opt_all || $opt_multi,
    );
}
if ($need_login) {
    my $login_info = do_login(config => $cfg);
    push(@cmd_options, login => $login_info);
    if ($command_info->{accounts}) {
        my $account_info = do_list(
            login => $login_info,
            quiet => 1,
        );
        push(@cmd_options, accounts => $account_info);
    }
}
if ($command_info->{dates}) {
    push(@cmd_options,
        start_date => $opt_start_date,
        end_date => $opt_end_date,
    );
}
$command->(@cmd_options);

END {
    # catch write errors:
    local $ERRNO = 0;
    close(STDOUT) or os_error("stdout: $ERRNO");
    close(STDERR) or os_error("stderr: $ERRNO");
}

# vim:ts=4 sw=4 et
